home *** CD-ROM | disk | FTP | other *** search
/ CD World 1998 January / CD World - Ocak 1998.iso / misc / dbase55 / disk7 / samples1.pak / SAMPPROC.PRG < prev    next >
Text File  |  1995-07-18  |  6KB  |  202 lines
  1. *******************************************************************************
  2. *  PROGRAM:      Sampproc.prg
  3. *
  4. *  WRITTEN BY:   Borland Samples Group
  5. *
  6. *  DATE:         6/94
  7. *
  8. *  UPDATED:      5/95
  9. *
  10. *  REVISION:     $Revision:   1.48  $
  11. *
  12. *  VERSION:      Visual dBASE
  13. *
  14. *  DESCRIPTION:  This is a general procedure file containing useful functions
  15. *                called by some of the sample programs.
  16. *
  17. *  PARAMETERS:   None
  18. *
  19. *  CALLS:        None
  20. *
  21. *  USAGE:        SET PROCEDURE TO Sampproc.prg ADDITIVE
  22. *
  23. ********************************************************************************
  24. #include <Messdlg.h>
  25.  
  26. InformationMessage("Sampproc.prg is a procedure file used by the samples.","Info")
  27.  
  28. ********************************************************************************
  29. function FormatStr(string)
  30.  
  31. * Could have 0 or more parameters.
  32. * This function will replace occurrences of "%<n>" with the corresponding
  33. * parameter string.  It will also replace all occurrences of "\n" with a Carriage
  34. * Return, and all occurrences of "\t" with a Tab.
  35. *
  36. * Example: x = FormatStr("Hello \n %1", "World") &&prints Hello World on 2 lines
  37. ********************************************************************************
  38. #define ENTER  chr(13)
  39. #define TAB    chr(9)
  40. local i, strPos, strCnt, tmpStr
  41.  
  42. tmpStr = string
  43. for i = 2 to argc()    && while have something to search for
  44.    tmpStr = StrTran(tmpStr, "%" + ltrim(str(i - 1)), argv(i))
  45. next
  46. tmpStr = StrTran(tmpStr, "\n", ENTER)
  47. tmpStr = StrTran(tmpStr, "\t", TAB)
  48.  
  49. return tmpStr
  50.  
  51.  
  52. *******************************************************************************
  53. function StrTran(string,curStr,repStr)
  54.  
  55. * Replaces all occurrences of curStr in string with repStr
  56. *******************************************************************************
  57. local strPos, lenCurStr, tmpStr
  58.  
  59. tmpStr = string
  60. lenCurStr = len(curStr)
  61. strPos = at(curStr, tmpStr)
  62. do while strPos > 0
  63.    tmpStr = stuff(tmpStr, strPos, lenCurStr, repStr)
  64.    strPos = at(curStr, tmpStr)
  65. enddo
  66. return tmpStr
  67.  
  68.  
  69.  
  70. *******************************************************************************
  71. procedure SetEnvironment
  72.  
  73. * Environment settings used by most samples (not necessarily this proc, though)
  74. *******************************************************************************
  75. set talk off
  76. set ldCheck off
  77.  
  78.  
  79. *******************************************************************************
  80. *******************************************************************************
  81. CLASS SAMPINFOFORM(sampleName) OF FORM
  82.  
  83. * Class for displaying information from the samples.  This information is
  84. * extracted from Samples.txt.
  85. *******************************************************************************
  86.    this.Top = 10
  87.    this.Height = 7.2344
  88.    this.ColorNormal = "GB+"
  89.    this.PageNo = 1
  90.    this.Text = sampleName
  91.    this.TopMost = .F.
  92.    this.Width = 65    &&31.333
  93.    this.Left = 18
  94.    this.MDI = .F.
  95.    this.Sizeable = .F.
  96.    this.Maximize = .F.
  97.    this.Minimize = .F.
  98.    this.Sysmenu = .F.
  99.    this.OnClose = CLASS::Form_OnClose
  100.  
  101.    DEFINE EDITOR INFOEDITOR OF THIS;
  102.        PROPERTY;
  103.          CUATab .T.,;
  104.          Top 1.2,;
  105.          Height 6.0,;
  106.          FontBold .F.,;
  107.          ColorNormal "B+/GB+",;
  108.          PageNo 1,;
  109.          Border .F.,;
  110.          Width 64,;
  111.          Wrap .F.,;
  112.          Left 1,;
  113.          Value "",;
  114.          Modify .F.
  115.  
  116.    DEFINE PUSHBUTTON CLOSEBUTTON OF THIS;
  117.        PROPERTY;
  118.          Top 0,;
  119.          Height 1.1172,;
  120.          ColorNormal "BtnText/BtnFace",;
  121.          PageNo 1,;
  122.          Text "",;
  123.          Width 3.5,;
  124.          UpBitmap "RESOURCE #36",;
  125.          Group .T.,;
  126.          Left 0,;
  127.          OnClick {;form.Close()}
  128.  
  129.    this.fileName = CLASS::CreateTempFile(sampleName)
  130.    if .not. empty(this.fileName)
  131.       this.infoEditor.dataLink = "file " + this.fileName
  132.    endif
  133.  
  134.  
  135.    ****************************************************************************
  136.    Procedure Form_OnClose
  137.  
  138.    * Close info form, and delete info file, if it exists.
  139.    ****************************************************************************
  140.    private fileName
  141.  
  142.    if .not. empty(this.fileName)
  143.       fileName = this.fileName
  144.       this.infoEditor.dataLink = ""
  145.       erase &fileName
  146.    endif
  147.  
  148.  
  149.    ****************************************************************************
  150.    Function CreateTempFile(sampleName)
  151.  
  152.    * Create temporary file containing information about sampleName, extracted
  153.    * from Samples.txt
  154.    ****************************************************************************
  155.    #define END_SAMPLE_DESCRIPT   "*"
  156.    private tempFileName, fhSamplesTxt, fhTempFile, line, bSampleFound, result
  157.  
  158.    tempFileName = ""
  159.    fhSamplesTxt = fopen("Samples.txt", "R")     && Open Samples.txt Read-only
  160.    if fhSamplesTxt = 0
  161.       InformationMessage("Samples.txt was not found, or couldn't be opened.",;
  162.                          "Info")
  163.    else
  164.       bSampleFound = .F.
  165.       do while .not. bSampleFound .and. .not. feof(fhSamplesTxt)
  166.          line = fgets(fhSamplesTxt)             && Search until find sampleName
  167.          if upper(rtrim(line)) = upper(sampleName)
  168.             bSampleFound = .T.
  169.          endif
  170.       enddo
  171.       if .not. bSampleFound                     && Reached end of file
  172.          InformationMessage("Information about " + sampleName +;
  173.                                " was not found in Samples.txt.",;
  174.                             "Sorry")
  175.       else                                      && Save info to temp file
  176.          tempFileName = fUnique()
  177.          fhTempFile = fCreate(tempFileName, "RW")
  178.          if fhTempFile = 0                      && Couldn't create file
  179.             InformationMessage("Couldn't create temp file.",;
  180.                                "Sorry")
  181.          else                                   && Temp file was created
  182.             line = fgets(fhSamplesTxt)          && Underscore line
  183.             line = fgets(fhSamplesTxt)
  184.             do while rtrim(line) <> END_SAMPLE_DESCRIPT .and.;
  185.                   .not. feof(fhSamplesTxt)
  186.                result = fputs(fhTempFile, line)
  187.                line = fgets(fhSamplesTxt)
  188.             enddo
  189.  
  190.             result = fclose(fhTempFile)
  191.          endif
  192.       endif
  193.       result = fclose(fhSamplesTxt)
  194.    endif
  195.  
  196.    return tempFileName
  197.  
  198.  
  199. ENDCLASS
  200.  
  201.  
  202.